.md # Εξέλιξη πολιτικών σχηματισμών :::info Συγγραφή: *Κώστας Κούδας* Υλοποίηση μέσω γλώσσας Wolfram στο [WLJS Notebook](https://jerryi.github.io/wljs-docs/). ::: :::warning ⚠️ ΥΠΟ ΚΑΤΑΣΚΕΥΗ ⚠️ ::: ## Μανιχαϊστικό μοντέλο Έστω ότι τη χρονική στιγμή `t` το αναμενόμενο πλήθος αριστερών είναι `aristeroi[t]` και των δεξιών `dexioi[t]`. Θεωρούμε ότι το παιδί ενός αριστερού παραμένει αριστερό με κάποια πιθανότητα ή γίνεται δεξιό με κάποια άλλη πιθνότητα. Συγκεκριμένα, θεωρούμε πως αν υπάρχουν μόνο αριστεροί στην κοινωνία, τότε η πιθανότητα κάποιος αριστερός να κάνει δεξιό παιδί είναι `a0`. Από την άλλη, αν δεν υπάρχουν σχεδόν καθόλου αριστεροί, το να παραμείνει αριστερό ένα παιδί αριστερού έχει πιθανότητα `a1`. Ή, με άλλα λόγια, θα γίνει δεξιό με πιθανότητα `1-a1`. Για τις ενδιάμεσες περιπτώσεις θεωρούμε πως η πιθανότητα να γίνει δεξιό το παιδί αριστερού είναι κάτι ενδιάμεσο των `a0` και `1-a1`. Για την ακρίβεια, θεωρούμε πως κάθε ποσοστιαία αύξιση των δεξιών επιφέρει ανάλογη αύξηση της πιθανότητας το παιδί να γίνει δεξιό. Έτσι, τη χρονική στιγμή `t` η πιθανότητα ένα παιδί αριστερού να γίνει δεξιό θα είναι `a0+(1-a1-a0)dexioi[t]/(aristeroi[t]+dexioi[t])`. Με απλές πράξεις προκύπτει ότι τη χρονική στιγμή `t` η πιθανότητα ένα παιδί αριστερού να παραμείνει αριστερό είναι `1-a0+(a1-1+a0)dexioi[t]/(aristeroi[t]+dexioi[t])`. Με την ίδια λογική έχουμε ότι η πιθανότητα ένα παιδί δεξιού να γίνει αριστερό είναι `d0+(1-d1-d0)aristeroi[t]/(aristeroi[t]+dexioi[t])`, ενώ η πιθανότητα να παραμείνει δεξιό είναι `1-d0+(d1-1+d0)aristeroi[t]/(aristeroi[t]+dexioi[t])`. Συνεπώς, αν κάθε άνθρωπος κάνει `c` παιδιά, τότε ο αναμενόμενος αρθμός αριστερών τη χρονική στιγμή `t+1` θα είναι: `(1-a0+(a1-1+a0)dexioi[t]/(aristeroi[t]+dexioi[t]))*c*aristeroi[t]+(d0+(1-d1-d0)aristeroi[t]/(aristeroi[t]+dexioi[t]))*c*dexioi[t]`, ενώ ο αναμενόμενος αριθμός δεξιών θα είναι: `(a0+(1-a1-a0)dexioi[t]/(aristeroi[t]+dexioi[t]))*c*aristeroi[t]+(1-d0+(d1-1+d0)aristeroi[t]/(aristeroi[t]+dexioi[t]))*c*dexioi[t]`. Επομένως έχουμε τις κάτωθι εξισώσεις:

Εξέλιξη πολιτικών σχηματισμών

:::info

Συγγραφή: *Κώστας Κούδας*

Υλοποίηση μέσω γλώσσας Wolfram στο [WLJS Notebook](https://jerryi.github.io/wljs-docs/).

:::

:::warning

⚠️ ΥΠΟ ΚΑΤΑΣΚΕΥΗ ⚠️

:::

Μανιχαϊστικό μοντέλο

Έστω ότι τη χρονική στιγμή `t` το αναμενόμενο πλήθος αριστερών είναι `aristeroi[t]` και των δεξιών `dexioi[t]`.

Θεωρούμε ότι το παιδί ενός αριστερού παραμένει αριστερό με κάποια πιθανότητα ή γίνεται δεξιό με κάποια άλλη πιθνότητα. Συγκεκριμένα, θεωρούμε πως αν υπάρχουν μόνο αριστεροί στην κοινωνία, τότε η πιθανότητα κάποιος αριστερός να κάνει δεξιό παιδί είναι `a0`. Από την άλλη, αν δεν υπάρχουν σχεδόν καθόλου αριστεροί, το να παραμείνει αριστερό ένα παιδί αριστερού έχει πιθανότητα `a1`. Ή, με άλλα λόγια, θα γίνει δεξιό με πιθανότητα `1-a1`. Για τις ενδιάμεσες περιπτώσεις θεωρούμε πως η πιθανότητα να γίνει δεξιό το παιδί αριστερού είναι κάτι ενδιάμεσο των `a0` και `1-a1`. Για την ακρίβεια, θεωρούμε πως κάθε ποσοστιαία αύξιση των δεξιών επιφέρει ανάλογη αύξηση της πιθανότητας το παιδί να γίνει δεξιό. Έτσι, τη χρονική στιγμή `t` η πιθανότητα ένα παιδί αριστερού να γίνει δεξιό θα είναι `a0+(1-a1-a0)dexioi[t]/(aristeroi[t]+dexioi[t])`. Με απλές πράξεις προκύπτει ότι τη χρονική στιγμή `t` η πιθανότητα ένα παιδί αριστερού να παραμείνει αριστερό είναι `1-a0+(a1-1+a0)dexioi[t]/(aristeroi[t]+dexioi[t])`.

Με την ίδια λογική έχουμε ότι η πιθανότητα ένα παιδί δεξιού να γίνει αριστερό είναι `d0+(1-d1-d0)aristeroi[t]/(aristeroi[t]+dexioi[t])`, ενώ η πιθανότητα να παραμείνει δεξιό είναι `1-d0+(d1-1+d0)aristeroi[t]/(aristeroi[t]+dexioi[t])`.

Συνεπώς, αν κάθε άνθρωπος κάνει `c` παιδιά, τότε ο αναμενόμενος αρθμός αριστερών τη χρονική στιγμή `t+1` θα είναι:

`(1-a0+(a1-1+a0)dexioi[t]/(aristeroi[t]+dexioi[t]))*c*aristeroi[t]+(d0+(1-d1-d0)aristeroi[t]/(aristeroi[t]+dexioi[t]))*c*dexioi[t]`,

ενώ ο αναμενόμενος αριθμός δεξιών θα είναι:

`(a0+(1-a1-a0)dexioi[t]/(aristeroi[t]+dexioi[t]))*c*aristeroi[t]+(1-d0+(d1-1+d0)aristeroi[t]/(aristeroi[t]+dexioi[t]))*c*dexioi[t]`.

Επομένως έχουμε τις κάτωθι εξισώσεις:

Clear["Global`*"] c=2; a0=0.1; a1=0.3; d0=0.2; d1=0.1; aristeroi[0]=10000; dexioi[0]=90000; aristeroi[n_] := aristeroi[n] = (1-a0+(a1-1+a0)dexioi[n-1]/(aristeroi[n-1]+dexioi[n-1]))*c*aristeroi[n-1]+(d0+(1-d1-d0)aristeroi[n-1]/(aristeroi[n-1]+dexioi[n-1]))*c*dexioi[n-1] dexioi[n_] := dexioi[n] =(a0+(1-a1-a0)dexioi[n-1]/(aristeroi[n-1]+dexioi[n-1]))*c*aristeroi[n-1]+(1-d0+(d1-1+d0)aristeroi[n-1]/(aristeroi[n-1]+dexioi[n-1]))*c*dexioi[n-1] aProp = Table[aristeroi[n]/(aristeroi[n]+dexioi[n]),{n,0,50}]; ListPlot[aProp] (* Υπολογισμός των διανυσμάτων *) listAB = Table[{aristeroi[n]/(aristeroi[n]+dexioi[n]), dexioi[n]/(aristeroi[n]+dexioi[n])}, {n, 0, 55}]; vectors = Table[ listAB[[n + 1]] - listAB[[n]], {n, 1, Length[listAB] - 1}]; (* Συνδυασμός αρχικών σημείων και διανυσμάτων *) vectorData = Table[ {listAB[[n]], vectors[[n]]}, {n, 1, Length[vectors]}]; (* Χρήση ListVectorPlot *) pl=ListVectorPlot[vectorData, VectorPoints -> All, PlotLegends->Automatic] Clear["Global`*"] c=2; a0=0.1; a1=0.3; d0=0.2; d1=0.1; aristeroi[n_] := aristeroi[n] = (1-a0+(a1-1+a0)dexioi[n-1]/(aristeroi[n-1]+dexioi[n-1]))*c*aristeroi[n-1]+(d0+(1-d1-d0)aristeroi[n-1]/(aristeroi[n-1]+dexioi[n-1]))*c*dexioi[n-1] dexioi[n_] := dexioi[n] =(a0+(1-a1-a0)dexioi[n-1]/(aristeroi[n-1]+dexioi[n-1]))*c*aristeroi[n-1]+(1-d0+(d1-1+d0)aristeroi[n-1]/(aristeroi[n-1]+dexioi[n-1]))*c*dexioi[n-1] aristeroi[0]=10; dexioi[0]=60; (* Δημιουργία της λίστας με τα σημεία *) listAB = Table[{aristeroi[n]/(aristeroi[n]+dexioi[n]), dexioi[n]/(aristeroi[n]+dexioi[n])}, {n, 0, 20}]; (* Δημιουργία των βελών *) arrows = Table[ Arrow[{listAB[[n]], listAB[[n + 1]]}], {n, 1, Length[listAB] - 1}]; (* Απεικόνιση των βελών *) Graphics[arrows, Axes -> True, AspectRatio -> 1] Clear["Global`*"] c=2; a0=1/10; a1=3/10; d0=2/10; d1=1/10; ar2 = (1-a0+(a1-1+a0)d/(a+d))*c*a+(d0+(1-d1-d0)a/(a+d))*c*d; de2 = (a0+(1-a1-a0)d/(a+d))*c*a+(1-d0+(d1-1+d0)a/(a+d))*c*d; eqA = ar2/(ar2+de2)-a/(a+d)==0 eqD = de2/(ar2+de2)-d/(a+d)==0 Solve[{eqA,eqD},{a,d}]//N Together[eqA[[1]]] Together[eqD[[1]]] ContourPlot[{eqA,eqD}, {a, -0.5,0.5}, {d, -0.5,0.5}] Clear["Global`*"] c=2; a0=1/10; a1=3/10; d0=2/10; d1=1/10; eqA = ((1-a0)*(a+d)+(a1-1+a0)d)*c*a+(d0*(a+d)+(1-d1-d0)a)*c*d==a(a+d) eqD = (a0*(a+d)+(1-a1-a0)d)*c*a+((1-d0)*(a+d)+(d1-1+d0)a)*c*d==d(a+d) Assuming[a>0,Solve[{eqA,eqD},{a,d}]] Together[((1-a0)*(a+d)+(a1-1+a0)d)*c*a+(d0*(a+d)+(1-d1-d0)a)*c*d-a(a+d)] .md ## Μοντέλο με διώξεις

Μοντέλο με διώξεις

.md ## Ύπαρξη κέντρου

Ύπαρξη κέντρου

.md Αυτό το μοντέλο θα είναι ίδιο με το αρχικό, μόνο που στην ανδεχόμενη μετάβαση από αριστερά στα δεξιά μεσολαβεί το κέντρο. Αυτό το μοντέλο θα είναι ίδιο με το αρχικό, μόνο που στην ανδεχόμενη μετάβαση από αριστερά στα δεξιά μεσολαβεί το κέντρο.